home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Completions / HTMLCompletions.tcl < prev    next >
Encoding:
Text File  |  1998-11-01  |  7.5 KB  |  213 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "HTMLCompletions.tcl"
  6.  #                                    created: 98-04-05 21.30.48 
  7.  #                                last update: 98-11-01 16.57.52 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.3
  13.  # 
  14.  # Copyright 1996-1998 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. # We want to be able to use CSS and JavaScript completions in HTML documents.
  25. catch {uplevel #0 {source "$HOME:Tcl:Completions:CSSCompletions.tcl"}}
  26. catch {uplevel #0 {source "$HOME:Tcl:Completions:JScrCompletions.tcl"}}
  27.  
  28.  
  29. set completions(HTML) {word completion::word}
  30.  
  31. # If current position is inside a tag, complete the tag or attributes
  32. # being written.
  33. proc HTML::Completion::word {dummy} {
  34.     global htmlElemAttrOptional1 HTMLmodeVars htmlColorAttr mode htmlElemKeyBinding
  35.     global basicColors htmluserColors htmlSpecColor htmlURLAttr htmlSpecURL HTMLmodeVars
  36.     global htmlSpecWindow htmlWindowAttr elecStopMarker
  37.     
  38.     if {[htmlIsInContainer SCRIPT]} {
  39.         # Pretend to be in JavaScript mode
  40.         set mode JScr
  41.         catch {bind::Completion}
  42.         set mode HTML
  43.         return 1
  44.     }
  45.     if {[htmlIsInContainer STYLE]} {
  46.         hctsmsl.tcl
  47.         # Pretend to be in CSS mode.
  48.         set mode CSS
  49.         catch {bind::Completion}
  50.         set mode HTML
  51.         return 1
  52.     }
  53.     
  54.     set pos [getPos]
  55.     set allTags [array names htmlElemAttrOptional1]
  56.     regsub -all {\{INPUT TYPE=[^ ]+} $allTags " " allTags
  57.     lappend allTags INPUT
  58.     
  59.     # Find the tag.
  60.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^ \t\r<>]+} [expr $pos - 1]} left]} {return 0}
  61.     if {![catch {search -s -f 0 -r 0 -m 0 {>} [expr $pos - 1]} right]
  62.     && [lindex $right 1] > [lindex $left 1] && [lindex $right 0] < $pos} {return 0}
  63.     set tag [string toupper [string range [eval getText $left] 1 end]]
  64.     if {$tag == "LI"} {
  65.         set ltype [htmlFindList]
  66.         if {$ltype == "UL"} {
  67.             set tag "LI IN UL"
  68.         } elseif {$ltype == "OL"} {
  69.             set tag "LI IN OL"
  70.         }            
  71.     }
  72.     # All INPUT elements are defined differently. Must extract TYPE.
  73.     if {$tag == "INPUT"} {
  74.         set dum [expr $pos + 500]
  75.         if {[regexp -nocase {[^<>]* TYPE=\"?([^ \t\r\"<>]+)\"?} [getText [lindex $left 1] [expr $dum < [maxPos] ? $dum : [maxPos]]] dum tag]} {
  76.             set tag [string toupper $tag]
  77.             if {![info exists htmlElemKeyBinding($tag)]} {set tag "INPUT TYPE=$tag"}
  78.         }
  79.     }
  80.     
  81.     set tagBegin [expr [lindex $left 0] + 1]
  82.     set tagEnd [lindex $left 1]
  83.     # opening or closing tag
  84.     set opening 1
  85.     if {[string index $tag 0] == "/"} {
  86.         set tag    [string range $tag 1 end]
  87.         incr tagBegin 1
  88.         set opening 0
  89.     }
  90.     # inside < and > or just right of < ?
  91.     if {![catch {search -s -f 1 -r 0 -m 0 {>} $pos} r1] && 
  92.     ![catch {search -s -f 1 -r 0 -m 0 {<} $pos} l1] &&
  93.     [lindex $r1 0] < [lindex $l1 0]} {
  94.         set inside 1
  95.     } else {
  96.         set inside 0
  97.     }
  98.     
  99.     # Are we typing the tag or an attribute?
  100.     if {$tagEnd == $pos} {
  101.         # tag
  102.         set matches ""
  103.         foreach t $allTags {
  104.             if {[string match "$tag*" $t]} {lappend matches $t}
  105.         }
  106.         if {![llength $matches]} {
  107.             select $tagBegin $tagEnd
  108.         } else {
  109.             set newTag [largestPrefix $matches]
  110.             if {!$inside} {
  111.                 append newTag >
  112.                 if {$HTMLmodeVars(useTabMarks) && ($opening || [llength $matches] > 1)} {append newTag $elecStopMarker}
  113.             }
  114.             replaceText $tagBegin $tagEnd [htmlSetCase $newTag]
  115.             if {!$inside && ($opening || [llength $matches] > 1)} {goto [expr [getPos] - 1 - $HTMLmodeVars(useTabMarks)]}
  116.         }
  117.     } else {
  118.         # Attribute
  119.         if {!$opening} {return 1}
  120.         # are we between quotes to type the attribute value?
  121.         if {![catch {search -s -f 0 -r 1 -m 0 {=\"[^\"]*\"} [expr $pos - 1]} pos5] &&  [lindex $pos5 0] > $tagBegin &&
  122.         [lindex $pos5 1] > $pos} {
  123.             if {![catch {search -s -f 0 -r 1 -m 0 {[ \t\r\"][^ \t\r\"=]+=\"[^\"]*\"} [expr $pos - 1]} attPos] && [lindex $attPos 0] > $tagBegin && 
  124.             [lindex $attPos 1] > $pos} {
  125.                 set txt [getText [expr [lindex $attPos 0] + 1] [lindex $attPos 1]]
  126.                 regexp {([^=]+=)\"([^\"]*)\"} $txt dum attr val
  127.                 set attr [string toupper $attr]
  128.                 set begin [expr [lindex $attPos 0] + 2 + [string length $attr]]
  129.                 set end [expr [lindex $attPos 1] - 1]
  130.                 set choices [htmlGetChoices $tag]
  131.                 set isURL 0
  132.                 if {[lsearch $choices "$attr*"] < 0} {
  133.                     if {[lsearch -exact [concat [htmlGetRequired $tag] [htmlGetOptional $tag]] $attr] < 0} {return 0}
  134.                     set isChoice 0
  135.                     if {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${tag}!=[string trimright $attr =]"] < 0) || \
  136.                     [lsearch -exact $htmlSpecColor "${tag}=[string trimright $attr =]"] >= 0} {
  137.                         set choices [concat $basicColors [array names htmluserColors]]
  138.                     } elseif {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${tag}!=[string trimright $attr =]"] < 0) || \
  139.                     [lsearch -exact $htmlSpecURL "${tag}=[string trimright $attr =]"] >= 0} {
  140.                         set choices $HTMLmodeVars(URLs)
  141.                         set isURL 1
  142.                     } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${tag}!=[string trimright $attr =]"] < 0) || \
  143.                     [lsearch -exact $htmlSpecWindow "${tag}=[string trimright $attr =]"] >= 0} {
  144.                         set choices [concat _self _blank _top _parent $HTMLmodeVars(windows)]
  145.                     } else {
  146.                         return 0
  147.                     }
  148.                 } else {
  149.                     set val [string toupper $val]
  150.                     set isChoice 1
  151.                 }
  152.                 
  153.                 set matches ""
  154.                 foreach c $choices {
  155.                     if {$isChoice && [string match "${attr}$val*" $c]} {
  156.                         lappend matches [string range $c [string length $attr] end]
  157.                     } elseif {!$isChoice && [string match "$val*" $c]} {
  158.                         lappend matches $c
  159.                     }
  160.                 }
  161.                 if {![llength $matches]} {
  162.                     select $begin $end
  163.                 } else {
  164.                     set newval [largestPrefix $matches]
  165.                     if {$isChoice} {set newval [htmlSetCase $newval]}
  166.                     if {$isURL} {set newval [htmlURLescape2 $newval]} 
  167.                     replaceText $begin $end $newval
  168.                 }
  169.                 return 1
  170.             }
  171.         }
  172.  
  173.         # we are typing the attribute itself.
  174.         set addSpace 0
  175.         if {[set c [lookAt [getPos]]] != " " && $c != ">"} {set addSpace 1} 
  176.         backwardWord
  177.         set attrBegin [getPos]
  178.         set attrEnd $pos
  179.         set attr [string toupper [getText $attrBegin $attrEnd]]
  180.         set eventAtts [htmlGetSomeAttrs $tag EventHandler 1]
  181.         set allAttrs [concat [htmlGetRequired $tag] [string toupper [htmlGetOptional $tag]]]
  182.         if {$tag == "INPUT"} {set allAttrs TYPE=}
  183.         set matches ""
  184.         foreach t $allAttrs {
  185.             if {[string match "$attr*" $t]} {lappend matches $t}
  186.         }
  187.         if {![llength $matches]} {
  188.             select $attrBegin $attrEnd
  189.         } else {
  190.             if {[lookAt [expr $attrBegin - 1]] == "\""} {set newAttr " "}
  191.             append newAttr [largestPrefix $matches]
  192.             if {[set i [lsearch [string toupper $eventAtts] "[string trim $newAttr]*"]] >= 0} {
  193.                 set ext ""
  194.                 if {[string index $newAttr 0] == " "} {set ext " "}
  195.                 set newAttr "$ext[string range [lindex $eventAtts $i] 0 [expr [string length [string trim $newAttr]] - 1]]"
  196.             } else {
  197.                 set newAttr [htmlSetCase $newAttr]
  198.             }
  199.             set backup 1
  200.             if {[llength $matches] == 1} {
  201.                 if {[regexp {=} $newAttr]} {
  202.                     append newAttr "\"\""
  203.                     if {$HTMLmodeVars(useTabMarks)} {append newAttr $elecStopMarker}
  204.                 }
  205.                 if {$addSpace} {append newAttr " "; set backup 2} 
  206.             }
  207.             replaceText $attrBegin $attrEnd $newAttr
  208.             if {[llength $matches] == 1 && [regexp {=} $newAttr]} {goto [expr [getPos] - $backup - $HTMLmodeVars(useTabMarks)]}
  209.         }
  210.     }
  211.     return 1
  212. }
  213.